home *** CD-ROM | disk | FTP | other *** search
/ L' Effet Pommier 3 / L'Effet Pommier - Volume 03.iso / Programmation / Alpha ƒ / Tcl / SystemCode / c.tcl < prev    next >
Text File  |  1996-01-22  |  12KB  |  405 lines
  1.  
  2. newModeVar C elecColon {1} 1
  3. newModeVar C elecRBrace {1} 1
  4. newModeVar C leftFillColumn {3} 0
  5. newModeVar C prefixString {//} 0 
  6. newModeVar C electricSemi {1} 1
  7. newModeVar C wordBreak {[a-zA-Z0-9_]+} 0
  8. newModeVar C elecLBrace {1} 1
  9. newModeVar C elecElse {1} 1
  10. newModeVar C wordWrap {0} 1
  11. newModeVar C funcExpr {^[^ \t\(#\r/@].*\(.*\)$} 0
  12. newModeVar C wordBreakPreface {[^a-zA-Z0-9_]} 0
  13. newModeVar C electricTab {0} 1
  14. newModeVar C autoMark    0    1
  15. newModeVar C stringColor    green    0
  16. newModeVar C commentColor    red    0
  17. newModeVar C keywordColor    blue    0
  18.  
  19. set cCommentRegexp    {/\*(([^*]/)|[^*]|\r)*\*/}
  20. set cPreRegexp        {^\#[\t ]*[a-z]*}
  21. set    cKeyWords    {
  22.     void break register short enum extern int for if while struct static long continue
  23.     switch case char unsigned double float return else default goto do pascal Boolean
  24.     typedef volatile union auto sizeof size_t
  25. }
  26. if {[info exists Cwords]} {set cKeyWords [concat $cKeyWords $Cwords]}
  27. regModeKeywords -e {//} -b {/*} {*/} -c $CmodeVars(commentColor) -k $CmodeVars(keywordColor) -s $CmodeVars(stringColor) -m {#} C $cKeyWords
  28.  
  29. #================================================================================
  30.  
  31. newModeVar C++ elecColon {1} 1
  32. newModeVar C++ elecRBrace {1} 1
  33. newModeVar C++ leftFillColumn {3} 0
  34. newModeVar C++ prefixString {//} 0
  35. newModeVar C++ electricSemi {1} 1
  36. newModeVar C++ wordBreak {[a-zA-Z0-9_]+} 0
  37. newModeVar C++ elecLBrace {1} 1
  38. newModeVar C++ elecElse {1} 1
  39. newModeVar C++ wordWrap {0} 1
  40. newModeVar C++ funcExpr {^[^ \t\(#\r/@].*\(.*\)$} 0
  41. newModeVar C++ wordBreakPreface {[^a-zA-Z0-9_]} 0
  42. newModeVar C++ electricTab {1} 1
  43. newModeVar C++ autoMark        0    1
  44. newModeVar C++ stringColor    green    0
  45. newModeVar C++ commentColor    green    0
  46. newModeVar C++ keywordColor    blue    0
  47.  
  48.  
  49. set {c++KeyWords} {
  50.     new delete class friend protected private public template 
  51.     try catch throw operator const mutable virtual asm inline this
  52.     and and_eq bitand bitor compl not or or_eq xor xor_eq not_eq
  53.     wchar_t bool true false
  54.     static_cast dynamic_cast reinterpret_cast typeid
  55.     using namespace inherited
  56. }
  57. if {[info exists {C++words}]} {
  58.     set {c++KeyWords} [concat ${c++KeyWords} ${C++words} $cKeyWords]
  59. } else {
  60.     set {c++KeyWords} [concat ${c++KeyWords} $cKeyWords]
  61. }
  62.  
  63. regModeKeywords -e {//} -b {/*} {*/} -c [set C++modeVars(commentColor)] -k [set C++modeVars(keywordColor)] -s [set C++modeVars(stringColor)] -m {#} {C++} ${c++KeyWords}
  64. unset cKeyWords
  65. unset {c++KeyWords}
  66.  
  67. #=============================================================================
  68. # "Electric" C functions.
  69. #=============================================================================
  70.  
  71. # returns the indent string of the line named by 'pos'
  72. proc indentString pos {
  73.     set start [lineStart $pos]
  74.     set end [nextLineStart $pos]
  75.     set text [getText $start $end]
  76.     for {set i 0} {1} {incr i} {
  77.         set c [string index $text $i]
  78.         if {($c != "\ ") && ($c != "\t")} then {
  79.             return [string range $text 0 [expr $i-1]]
  80.         }
  81.     }
  82.     return
  83. }
  84.  
  85.  
  86. # Brace on new line, same indentation. Insert on another new line, indented in.
  87. # First, see if we are on new line.
  88. proc electricCLeft {} {
  89.     global mode
  90.     global ${mode}modeVars
  91.     deleteText [getPos] [selEnd]
  92.     if {![set ${mode}modeVars(elecLBrace)]} then {
  93.         insertText "\{"
  94.         return
  95.     }
  96.     if {[set ${mode}modeVars(elecLBrace)] && ![catch {search -l [lineStart [expr [lineStart [getPos]] - 1]] -s -f 0 -r 0 "\}" [getPos]} res]} {
  97.         if {[regexp {\}[ \t\r]*else} [getText [lindex $res 0] [expr [getPos] + 1]]]} {
  98.             set res2 [search -f 0 -r 0 {else} [getPos]]
  99.             oneSpace
  100.             set text [getText [lindex $res2 0] [getPos]]
  101.             if {[lookAt [expr [getPos] - 1]] != " "} {
  102.                 append text " "
  103.             }
  104.             replaceText [expr [lindex $res 0] + 1] [getPos] " $text\{\r"
  105.             indentLine
  106.             return
  107.         }
  108.     }
  109.     set pos [getPos]
  110.     set start [lineStart $pos]
  111.     set text [getText $start $pos]
  112.     
  113.     for {set i $start} {$i < $pos} {incr i} {
  114.         set c [lookAt $i]
  115.         if {($c != "\ ") && ($c != "\t")} then {
  116.             break;
  117.         }
  118.     }
  119.     set indentation [getText $start $i]
  120.     if {($i == $pos) || ([lookAt $pos] == " ")} {
  121.         insertText "\{\r" $indentation "\t"
  122.     } else {
  123.         insertText " \{\r" $indentation "\t"
  124.     }
  125. }
  126. bind '\{' <s> electricCLeft C
  127. bind '\{' <s> electricCLeft C++
  128.  
  129.  
  130. # Brace on new line, immediate carriage return
  131. proc electricCRight {} {
  132.     global mode
  133.     global ${mode}modeVars
  134.     
  135.     deleteText [getPos] [selEnd]
  136.     if {[set ${mode}modeVars(elecRBrace)] == "0"} then {
  137.         insertText "\}"
  138.         catch {blink [matchIt "\}" [expr [getPos]-2]]}
  139.         return
  140.     }
  141.     set pos [getPos]
  142.     set start [lineStart $pos]
  143.     
  144.     if {[catch {matchIt "\}" [expr $pos-1]} matched]} {
  145.         beep
  146.         return
  147.     }
  148.     set text [getText [lineStart $matched] $matched]
  149.     regexp {^[     ]*} $text indentation
  150.     for {set i $start} {$i < $pos} {incr i} {
  151.         set c [lookAt $i]
  152.         if {($c != "\ ") && ($c != "\t")} then {
  153.             insertText "\r" $indentation "\}\r" $indentation
  154.             blink $matched
  155.             return
  156.         }
  157.     }
  158.     set text [set indentation]\}\r$indentation
  159.     replaceText $start $pos $text
  160.     goto [expr {$start + [string length $text]}]
  161.     blink [matchIt "\}" [expr $start-2]]
  162. }
  163. bind '\}' <s> electricCRight C
  164. bind '\}' <s> electricCRight C++
  165.  
  166.  
  167. # Brace on new line, immediate carriage return. We don't do our electric stuff
  168. # if we are in the middle of a for statement.
  169. proc electricCSemi {} {
  170.     global mode
  171.     global ${mode}modeVars
  172.     deleteText [getPos] [selEnd]
  173.     if {[set ${mode}modeVars(electricSemi)] == "0"} then {
  174.         insertText ";"
  175.         return
  176.     }
  177.     set pos [getPos]
  178.     set start [lineStart $pos]
  179.     set text [getText $start $pos]
  180.     
  181.     if {[string first "for" $text] != "-1"} {
  182.         set lefts 0
  183.         set rights 0
  184.         set len [string length $text]
  185.         for {set i 0} {$i < $len} {incr i} {
  186.             case [string index $text $i] in {
  187.                 "("    { incr lefts }
  188.                 ")"    { incr rights }
  189.             }
  190.         }
  191.         global globs
  192.         set globs [list $lefts $rights $len]
  193.         if {$lefts != $rights} {
  194.             insertText ";"
  195.             return
  196.         }
  197.     }
  198.     
  199.     insertText ";\r" [indentString $pos]
  200. }
  201. bind '\;' electricCSemi C
  202. bind '\;' electricCSemi C++
  203.  
  204.  
  205. proc ordSemi {} {
  206.     insertText {;}
  207. }
  208.  
  209. bind '\;' <z> ordSemi
  210.  
  211.  
  212. proc cppCR {} {
  213.     if {[lookAt [expr [getPos] - 1]] == ":"} {
  214.         if { [lookAt [getPos]] == "\r" } {
  215.             indentLine
  216.             endOfLine
  217.             carriageReturn
  218.         } else {
  219.             set pos [getPos]
  220.             endOfLine
  221.             set t [getText $pos [getPos]]
  222.             replaceText $pos [getPos] ""
  223.             indentLine
  224.             endOfLine
  225.             carriageReturn
  226.             insertText $t
  227.         }
  228.         indentLine
  229.     } else {
  230.         carriageReturn
  231.         indentLine
  232.     }
  233.     
  234. }
  235.  
  236. bind '\r'     cppCR C
  237. bind '\r'     cppCR C++
  238.         
  239. #================================================================================
  240.  
  241. # proc CMarkFile {} {
  242. #     global CmodeVars
  243. #     set pos 0
  244. #     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 $CmodeVars(funcExpr) $pos} res]} {
  245. #         set start [lindex $res 0]
  246. #         set end [expr [lindex $res 1] + 1]
  247. #         set text [getText $start $end]
  248. #         if {[regexp {([a-zA-Z0-9:_]+)[ \t]*\(} $text dummy word]} {
  249. #             set tmp [expr $start + [string first $word $text]]
  250. #             set inds($word) "$tmp [expr $tmp + [string length $word]]"
  251. #         }
  252. #         set pos $end
  253. #     }
  254. #     if {[info exists inds]} {
  255. #         foreach f [lsort -ignore [array names inds]] {
  256. #             set res $inds($f)
  257. #             setNamedMark $f [lineStart [lindex $res 0]] [lindex $res 0] [lindex $res 1]
  258. #         }
  259. #     }
  260. # }
  261. # 
  262. #     
  263. # #The previous version would not find things like     void    *ThisFunc( xxx ) due to the asterisk
  264. # #I also truncated the pattern.  The rest is not necessary and intrusive as far as I can tell   
  265. # proc C++MarkFile {} {
  266. #     set pos 0
  267. #     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 {^([^ \t\(#\r/@].*[ \t]+)?\*?([A-Za-z0-9:~_]+)[ \t\r]*\(} $pos} res]} {
  268. #         set start [lindex $res 0]
  269. #         set end [expr [lindex $res 1] + 1]
  270. #         set thistext [getText $start $end]
  271. #         #regexp doesn't like carriage returns
  272. #         regsub -all "\r" $thistext " " thistext
  273. #         #regexp doesn't like tabs either
  274. #         regsub -all "\t" $thistext " " thistext
  275. #         #if the open paren was the last character on the line the selected text included the last carriage return as well
  276. #         #trim this off now that it is changed into a space
  277. #         set thistext [string trimright $thistext]
  278. #         if {[regexp {([a-zA-Z0-9:~_]+)[ \t]*\(} $thistext dummy word]} {
  279. #             set inds($word) [lineStart [expr $start - 1]]
  280. #         }
  281. #         set pos $end
  282. #     }
  283. #     if {[info exists inds]} {
  284. #         foreach f [lsort -ignore [array names inds]] {
  285. #             set next [nextLineStart $inds($f)]
  286. #             setNamedMark $f $inds($f) $next $next
  287. #         }
  288. #     }
  289. # }
  290.  
  291.  
  292. proc CMarkFile {} {
  293.     global CmodeVars
  294.     set pos 0
  295.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 $CmodeVars(funcExpr) $pos} res]} {
  296.         set start [lindex $res 0]
  297.         set end [expr [lindex $res 1] + 1]
  298.         set text [getText $start $end]
  299.         if {[regexp {([a-zA-Z0-9:_]+)[ \t]*\(} $text dummy word]} {
  300.             set tmp [expr $start + [string first $word $text]]
  301.             set inds($word) "$tmp [expr $tmp + [string length $word]]"
  302.         }
  303.         set pos $end
  304.     }
  305.  
  306.     ## 
  307.      # Also    mark any class or struct definitions
  308.      ##
  309.     
  310.     set markExpr {^(class|struct) [A-Za-z0-9_]+[ \t]*(:|\{)}
  311.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 "$markExpr" $pos} res]} {
  312.         set start [lindex $res 0]
  313.         set end [expr [lindex $res 1] -1]
  314.         set text [string trimright [getText $start $end] ]
  315.         set inds($text) "$start [expr $start + [string length $text]]"
  316.         set pos $end
  317.     }
  318.     if {[info exists inds]} {
  319.         foreach f [lsort -ignore [array names inds]] {
  320.             set res $inds($f)
  321.             setNamedMark $f [lineStart [lindex $res 0]] [lindex $res 0] [lindex $res 1]
  322.         }
  323.     }
  324. }
  325.  
  326. proc C++MarkFile {} {
  327.     set pos 0
  328.     set markExpr {^([^ \t\(#\r/@].*[ \t]+)?\*?([A-Za-z0-9<>~_]+::[-A-Za-z0-9~_+=\*/]+|[A-Za-z0-9~_]+)[ \t\r]*\(}
  329.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 "$markExpr" $pos} res]} {
  330.         set start [lindex $res 0]
  331.         set end [expr [lindex $res 1] + 1]
  332.         set thistext [getText $start $end]
  333.         #regexp doesn't like carriage returns
  334.         regsub -all "\r" $thistext " " thistext
  335.         #regexp doesn't like tabs either
  336.         regsub -all "\t" $thistext " " thistext
  337.         #if the open paren was the last character on the line the selected text 
  338.         #included the last carriage return as well
  339.         #trim this off now that it is changed into a space
  340.         set thistext [string trimright $thistext]
  341.         if {[regexp {([A-Za-z0-9<>~_]+::[-A-Za-z0-9~_+=\*/]+|[A-Za-z0-9~_]+)[ \t]*\(} $thistext dummy word]} {
  342.             if { [string first "::" $word] != -1 } {
  343.                 regsub {(<[A-Za-z0-9_]+>)?::} $word " " it
  344.                 set l [lindex $it 0]
  345.                 if { $l == [lindex $it 1] } {
  346.                     set word "Construct '$l'"
  347.                 } elseif { "~$l" == [lindex $it 1] } {
  348.                     set word "Destruct '$l'"
  349.                 }
  350.             }
  351.             set inds($word) [lineStart [expr $start - 1]]
  352.         }
  353.         set pos $end
  354.     }
  355.     if {[info exists inds]} {
  356.         foreach f [lsort -ignore [array names inds]] {
  357.             set next [nextLineStart $inds($f)]
  358.             # Alpha doesn't like '<' or '>' in the mark menu
  359.             regsub -all {[<>]+} $f "|" it
  360.             if {[string length $it] > 35} { set it "[string range $it 0 31]..." }
  361.             setNamedMark "${it}" "$inds($f)" $next $next
  362.         }
  363.     }
  364. }
  365.  
  366. proc setC++Mode {} {
  367.     changeMode "C++"
  368. }
  369.  
  370.  
  371.  
  372. source "$HOME:Tcl:SystemCode:think.tcl"
  373.  
  374. proc dummyC {} {}
  375. proc dummyC++ {} {}
  376.  
  377.  
  378. #===============================================================================
  379.  
  380. proc CDblClick {from to} {
  381.     global tagFile
  382.     
  383.     select $from $to
  384.     set text [getSelect]
  385.     
  386.     set lines [grep "^$text'" $tagFile]
  387.     if {[regexp {'(.*)'(.*[^\t])(\t)+░} $lines dummy one two]} {
  388.         if {[string match "*$one*" [winNames -f]]} {
  389.             bringToFront $one
  390.         } else {
  391.             edit $one
  392.         }
  393.         set inds [search -f 1 -r 0 "$two" 0]
  394.         display [lindex $inds 0]
  395.         eval select $inds
  396.     } else {
  397.         checkRunning ThinkReference DanR referencePath
  398.         AEBuild {'DanR'} DanR {REF } "----" "╥$text╙"
  399.     }
  400. }
  401.  
  402. proc C++DblClick {from to shift option control} {
  403.     CDblClick $from $to
  404. }
  405.